home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / stv.lha / STV / ISA / artifact / font.st < prev    next >
Text File  |  1993-07-23  |  7KB  |  221 lines
  1.  
  2. " Font Enhancements by Tom Wrensch & Gene Korienek
  3.  
  4.   This code will expand the font class with methods for
  5.   loading and unloading fonts to disk files.  It also
  6.   provides for more fonts than the basic three included
  7.   with V & V286.
  8.  
  9.   After this code is loaded, do the following to load
  10.   in the additional fonts I included: (note: you may
  11.   have to change the file pathname)
  12.  
  13.     Font loadFontFrom: (File pathName: 'a:es08.fnt').
  14.     Font loadFontFrom: (File pathName: 'a:es10.fnt').
  15.     Font loadFontFrom: (File pathName: 'a:es12.fnt').
  16.     Font loadFontFrom: (File pathName: 'a:es20.fnt').
  17.  
  18.   To get at these fonts use the Font class message getFont:.
  19.   Fonts now have names associated with them, the getFont:
  20.   message wants the name (a string) as its argument.  To
  21.   see the names of the fonts currently in the system do:
  22.  
  23.     Fonts keys
  24.  
  25.   To use these fonts you can set the global variables
  26.   TextFont, ListFont, and LabelFont.  There is also
  27.   SysFont but when changing that you must also change
  28.   SysFontHeight, SysFontWidth, and reinitialize the 
  29.   system and edit menus.
  30.  
  31.   I would be very interested in any other fonts people may
  32.   have created."
  33.  
  34.  
  35. "evaluate"
  36. Smalltalk at: #Fonts put: Dictionary new!
  37.  
  38. "evaluate"
  39. Fonts at: 'EightLine' put: Font eightLine!
  40.  
  41. "evaluate"
  42. Fonts at: 'FourteenLine' put: Font fourteenLine!
  43.  
  44. "evaluate"
  45. Fonts at: 'SixteenLine' put: Font sixteenLine!
  46.  
  47.  
  48. Object subclass: #Font
  49.   instanceVariableNames: 
  50.     'charSize glyphs xTable startChar endChar fixedWidth basePoint '
  51.   classVariableNames: ''
  52.   poolDictionaries: 
  53.     'Fonts ' !
  54.  
  55. !Font class methods !
  56.  
  57. changeFont: aFont
  58.         "Change to font aFont"
  59.     TextFont := ListFont := LabelFont := aFont.
  60.     self setSysFont: aFont.
  61.     ScreenDispatcher initialize.
  62.     TextEditor initialize.
  63.     TopDispatcher initialize.
  64.     Scheduler reinitialize.!
  65.  
  66. getFont: fontName
  67.         "Answer the font with the name fontName (a string)"
  68.     ^Fonts at: fontName!
  69.  
  70. loadFontFrom: aStream
  71.         "Set up a font load from the stream"
  72.     | font fontName |
  73.     font := self new.
  74.     aStream skipBlanksAndComments.
  75.     fontName := font loadNameFrom: aStream.
  76.     font loadFontFrom: aStream.
  77.     Fonts at: fontName put: font.
  78.     ^font! !
  79.  
  80.  
  81. !Font methods !
  82.  
  83. loadBooleanFrom: aStream
  84.         "Private - Answer the fixedWidth flag from aStream"
  85.     ^aStream nextLine first = $T!
  86.  
  87. loadByteFrom: aStream
  88.         "Private - Answer a byte value from aStream.  Ignore any
  89.          'whitespace' characters like Lf, Cr, Space and Tab"
  90.     | byte ascii |
  91.     ascii := 0.
  92.     [ascii < 65] whileTrue: [ascii := aStream next asciiValue].
  93.     byte := (ascii - 65) * 16.
  94.     ascii := 0.
  95.     [ascii < 65] whileTrue: [ascii := aStream next asciiValue].
  96.     byte := byte + (ascii - 65).
  97.     ^byte!
  98.  
  99. loadFontFrom: aStream
  100.         "Private - fill in the font information from aStream"
  101.     charSize := self loadPointFrom: aStream.
  102.     xTable := self loadXTableFrom: aStream.
  103.     startChar := self loadIntegerFrom: aStream.
  104.     endChar := self loadIntegerFrom: aStream.
  105.     fixedWidth := self loadBooleanFrom: aStream.
  106.     basePoint := self loadPointFrom: aStream.
  107.     glyphs := self loadFormFrom: aStream.!
  108.  
  109. loadFormFrom: aStream
  110.         "Private - Answer a form loaded from aStream"
  111.     | form |
  112.     form := Form new.
  113.     form extent: (self loadPointFrom: aStream).
  114.     (1 to: form bitmap size) do: [:i |
  115.         form bitmap at: i put: (self loadByteFrom: aStream)].
  116.     ^form!
  117.  
  118. loadIntegerFrom: aStream
  119.         "Private - Answer an integer from the stream aStream"
  120.     ^aStream nextLine asInteger!
  121.  
  122. loadNameFrom: aStream
  123.         "Private - Answer a name (string) from aStream"
  124.     ^aStream nextLine!
  125.  
  126. loadPointFrom: aStream
  127.         "Private - Answer a point from aStream"
  128.     ^(self loadIntegerFrom: aStream) @
  129.         (self loadIntegerFrom: aStream).!
  130.  
  131. loadXTableFrom: aStream
  132.         "Private - Answer the xTable from aStream.  Note that the
  133.          xTable is an array of offsets into the glyphs bitmap."
  134.     | table |
  135.     table := Array new: (self loadIntegerFrom: aStream).
  136.     1 to: table size do: [:i |
  137.         table at: i put: (self loadIntegerFrom: aStream)].
  138.     ^table!
  139.  
  140. unloadBoolean: bool to: aStream
  141.         "Private - Put a representation of the boolean value bool
  142.          on aStream."
  143.     aStream nextPut: (bool ifTrue: [$T] ifFalse: [$F]).
  144.     aStream cr.!
  145.  
  146. unloadByte: aByte to: aStream
  147.         "Private - Put a representation of aByte on aStream."
  148.     aStream nextPut: ((aByte // 16) + 65) asCharacter.
  149.     aStream nextPut: ((aByte rem: 16) + 65) asCharacter.!
  150.  
  151. unloadFont: fontName to: aStream
  152.         "Private - Put a representation of this font on aStream
  153.          using the name fontName."
  154.     self unloadName: fontName to: aStream.
  155.     self unloadPoint: charSize to: aStream.
  156.     self unloadXTable: xTable to: aStream.
  157.     self unloadInteger: startChar to: aStream.
  158.     self unloadInteger: endChar to: aStream.
  159.     self unloadBoolean: fixedWidth to: aStream.
  160.     self unloadPoint: basePoint to: aStream.
  161.     self unloadForm: glyphs to: aStream.!
  162.  
  163. unloadFontTo: aStream
  164.         "Unload this font on the stream aStream.  The format
  165.          of the file is such that there are no unprintable ascii
  166.          characters in the file.  This makes it easy to upload
  167.          and download the fonts."
  168.     | fontName |
  169.     Fonts associationsDo: [:a |
  170.         a value == self ifTrue: [fontName := a key]].
  171.     fontName isNil ifTrue: [fontName := ''].
  172.     self unloadFont: fontName to: aStream!
  173.  
  174. unloadForm: aForm to: aStream
  175.         "Private - Put a representation of the aFrom on aStream."
  176.     self unloadPoint: aForm extent to: aStream.
  177.     aForm bitmap do: [:byte |
  178.         self unloadByte: byte to: aStream].!
  179.  
  180. unloadInteger: anInteger to: aStream
  181.         "Private - Put a representation of anInteger on aStream"
  182.     anInteger printOn: aStream.
  183.     aStream cr.!
  184.  
  185. unloadName: aString to: aStream
  186.         "Private - Put a representation of aString onto aStream.
  187.          aString is expected to be a capitialized name."
  188.     aStream nextPutAll: aString.
  189.     aStream cr.!
  190.  
  191. unloadPoint: aPoint to: aStream
  192.         "Private - Answer a point from aStream"
  193.     self unloadInteger: aPoint x to: aStream.
  194.     self unloadInteger: aPoint y to: aStream.!
  195.  
  196. unloadXTable: table to: aStream
  197.         "Private - Put a representation of the array xTable on
  198.          the stream aStream."
  199.     self unloadInteger: table size to: aStream.
  200.     table do: [:int |
  201.         self unloadInteger: int to: aStream].! !
  202.  
  203.  
  204. !FileStream methods !
  205.  
  206. skipBlanksAndComments
  207.         "Skip over blanks, newlines, tabs and comments"
  208.     | done next |
  209.     done := false.
  210.     [done] whileFalse: [
  211.         next := self peek.
  212.         (next == Space or:
  213.             [next == Cr or:
  214.                 [next == Lf or:
  215.                     [next == Tab]]])
  216.             ifTrue: [self next]
  217.             ifFalse: [
  218.                 next == $"
  219.                     ifTrue: [self next; skipTo: $"]
  220.                     ifFalse: [done := true]]]! !
  221.